00100	BEGIN "MAIN"
00200	REQUIRE "HELIB[1,3]" LIBRARY;
00300	REAL ARRAY OBJECT[1:50,1:4];
00400	INTEGER ARRAY BUF[1:10000];
00500	INTEGER ARRAY STORAGE[1:25];
00600	INTEGER X,Y,NX,NY,PICNUM,NPTS,COUNT,BRCHAR,EXT,PPN,EOF,FLAG,VAL;
00700	REAL Z,Z2,VAL2,DX,XINIT,XFINAL,TOTX,YINIT,YFINAL,TOTY,DY;
00800	REAL LAMBDA,X2,Y2,SUM,A,B,C,A0,A2,A4,ARG2,ARG4;
00900	INTEGER NP,GREY,GREY2;
01000	STRING FILE;
01100	EXTERNAL INTEGER BITS,TVWORD,RSIDE,LSIDE,FLINE,LLINE,IWID;
01200	BOOLEAN FAIL;
01300	EXTERNAL PROCEDURE INTPNT;
01400	EXTERNAL PROCEDURE ADJUST;
01500	EXTERNAL PROCEDURE PUTPNT (INTEGER X,Y,VAL);
01600	EXTERNAL PROCEDURE PICWR(INTEGER CHAN,FILE,EXT,PPN;
01700	     REFERENCE BOOLEAN FAIL; INTEGER ARRAY STORAGE);
01800	EXTERNAL INTEGER PROCEDURE GIOWD(INTEGER ARRAY BUF);
01900	INTEGER PROCEDURE GETPAR;
02000	  BEGIN
02100	
02200	OPEN(2,"DSK",0,3,0,COUNT,BRCHAR,EOF);
02300	LOOKUP(2,"OBJ.1[2,DBL]",FLAG);
02400	OUTSTR("TYPE IN NPTS...");
02500	NPTS←CVD(INCHWL);
02600	FOR X←1 STEP 1 UNTIL NPTS DO
02700	  FOR Y←1 STEP 1 UNTIL 4 DO
02800	    OBJECT[X,Y] ← REALIN(2);
02900	CLOSE(2);
03000	FOR X←NPTS+1 STEP 1 UNTIL 50 DO
03100	  FOR Y←1 STEP 1 UNTIL 4 DO
03200	    OBJECT[X,Y]←0;
03300	OUTSTR("TYPE XINIT... ");
03400	XINIT←CVD(INCHWL);
03500	OUTSTR("TYPE XFINAL.. ");
03600	XFINAL←CVD(INCHWL);
03700	OUTSTR("TYPE DELTA-X.. ");
03800	DX←CVD(INCHWL);
03900	TOTX←XFINAL-XINIT;
04000	NX←(TOTX+DX-1.0)/DX;
04100	OUTSTR("THEN TOTAL-X IS "&CVF(TOTX)&"  AND NX (THE LINE LENGTH) IS "
04200	          &CVS(NX)&'15 & '12);
04300	OUTSTR("TYPE YINIT... ");
04400	YINIT←CVD(INCHWL);
04500	OUTSTR("TYPE YFINAL.. ");
04600	YFINAL←CVD(INCHWL);
04700	OUTSTR("TYPE DELTA-Y... ");
04800	DY←CVD(INCHWL);
04900	TOTY←YFINAL-YINIT;
05000	NY←(TOTY+DY-1)/DY;
05100	OUTSTR("THEN TOTAL-Y IS " & CVF(TOTY) &
05200	   "   AND NY (THE VERT. HEIGHT) IS " & CVS(NY) & '15 & '12);
05300	OUTSTR("TYPE LAMBDA (ACTUALLY, LAMBDA SQUARED /16 PI-SQUARED)... ");
05400	LAMBDA ← CVD(INCHWL);
05500	OUTSTR("TYPE THE LOG (BASE 2) OF THE GREY SCALE... ");
05600	BITS ← CVD(INCHWL);
05700	GREY ← 2↑BITS;
05800	GREY2 ← GREY / 2;
05900	A0 ←1.000000;
06000	A2 ←-.5000;
06100	A4 ←0.0400;
06200	OUTSTR("THUS OUR GREY SCALE RANGES FROM 1 TO "&CVS(GREY)
06300	  & '15 & '12);
06400	END;
06500	
06600	INTEGER PROCEDURE INIT; BEGIN
06700	  GETPAR;
06800	  TVWORD ← GIOWD(BUF);
06900	  RSIDE ←  NX-1;
07000	  LSIDE ← 0;
07100	  FLINE ← 0;
07200	  LLINE ←  NY-1;
07300	  IWID ← RSIDE - LSIDE + 1;
07400	
07500	
07600	FOR X ← 2 STEP 1 UNTIL 25 DO STORAGE[X]←0;
07700	STORAGE[1]←TVWORD+1;
07800	
07900	  ADJUST;
08000	  INTPNT;
08100	
08200	OUTSTR("TYPE IN THE PICTURE NUMBER....");
08300	PICNUM←CVD(INCHWL);
08400	FILE ← "H."&CVS(PICNUM)&"[2,DBL]";
08500	  END;
08600	
08700	REAL PROCEDURE COS2(REAL A,B,C);
08800	  BEGIN
08900	  ARG2 ← ((A*A) + (B*B) + (C*C)) / LAMBDA;
09000	  VAL2← (ARG2↑0.5) MOD 3.1416;
09100	  IF VAL2> 1.5708  THEN VAL2← 3.1416 - VAL2;
09200	  ARG2 ← VAL2*VAL2;
09300	  ARG4 ← ARG2 * ARG2;
09400	  VAL2← A0  + (A2*ARG2)  +  (A*ARG4);
09500	VAL ←  ((GREY2*VAL)/A0) + GREY2;
09600	  RETURN(VAL);
09700	  END;
09800	
09900	
10000	INTEGER PROCEDURE GETVAL(INTEGER X,Y);
10100	  BEGIN
10200	  SUM ← 0;
10300	  X2 ← XINIT + (DX*X);
10400	  Y2 ← YINIT + (DY*Y);
10500	  FOR NP← 1 STEP 1 UNTIL NPTS DO
10600	   SUM ← SUM + (OBJECT[NP,4]*COS2((X2-OBJECT[NP,1]),
10700	         (Y2-OBJECT[NP,2]),  OBJECT[NP,3]));
10800	  VAL ← SUM;
10900	  VAL ← (VAL MOD GREY2) + GREY2;
11000	  RETURN(VAL);
11100	  END;
11200	
11300	
11400	INIT;
11500	VAL←5;
11600	FOR X← LSIDE STEP 1 UNTIL RSIDE DO
11700	BEGIN
11800	  OUTSTR(CVS(X)&" "&CVS(VAL)&" ");
11900	  FOR Y ← FLINE STEP 1 UNTIL LLINE DO
12000	      PUTPNT(X,Y,GETVAL(X,Y));
12100	END;
12200	
12300	PICWR(1,CVFIL(FILE,EXT,PPN),EXT, PPN  ,FAIL,STORAGE);
12400	OUTSTR("BUF HAS BEEN TRANSFERRED TO FILE " & FILE);
12500	OUTSTR(CVS(FAIL)) 
12600	END ;
12700